Projekt zostaĆ stworzony w celu wykonania wizualizacji na podstawie danych dotyczÄ cych ruchu rowerowego w GdaĆsku. Ruch rowerowy monitorowany jest za pomocÄ stacji pomiarowych umiejscowionych w rĂłĆŒnych miejscach w mieĆcie. Zakres analizy obejmuje przedziaĆ czasowy od 01.10.2013 do 31.03.2021 roku. Projekt zakĆada stworzenie wizualizacji na podstawie dziewiÄciu poleceĆ. Do pierwszych dwĂłch poleceĆ zostanÄ wykorzystane wykresy z R Graphics, natomiast pozostaĆe polecenia zostanÄ wykonane przy pomocy pakietu ggplot2 oraz jego rozszerzeĆ.
ZostaĆy utworzone zmienne takie jak: Month, Year, Day, Dzie_tyg, Czy_Weekend oraz Pora_Roku na podstawie zmiennej Data, a takĆŒe zostaĆ zmieniony typ nowych zmiennych na factor.
przejazdy$Month <- month(ymd(przejazdy$Data))
przejazdy$Year <- year(ymd(przejazdy$Data))
przejazdy$Day <- day(ymd(przejazdy$Data))
przejazdy$Dzien_tyg <- as.character(przejazdy$Data, format = "%A")
przejazdy$Czy_Weekend <- ifelse(przejazdy$Dzien_tyg %in% c("sobota", "niedziela"),"weekend", "dzieĆ powszedni")
przejazdy <- przejazdy %>%
mutate(Month = factor(Month), Year = factor(Year), Day = factor(Day),
Dzien_tyg = factor(Dzien_tyg), Czy_Weekend = factor(Czy_Weekend))
przejazdy$Pora_Roku <- ifelse(przejazdy$Month %in% c("12", '1', '2'), 'Zima',
ifelse(przejazdy$Month %in% c("3", '4', '5'), 'Wiosna',
ifelse(przejazdy$Month %in% c("6", '7', '8'), 'Lato', 'JesieĆ')))
przejazdy$Pora_Roku <- as.factor(przejazdy$Pora_Roku)
levels(przejazdy$Month) <- c('1' = 'StyczeĆ', '2' = 'Luty', '3' = 'Marzec',
'4' = 'KwiecieĆ', '5' = 'Maj', '6' = 'Czerwiec',
'7' = 'Lipiec', '8' = 'SierpieĆ', '9' = 'WrzesieĆ',
'10' = 'PaĆșdziernik', '11' = 'Listopad', '12' = 'GrudzieĆ')
punkty <- rename(punkty, Stacja = stacja)
PrzedstawiÄ rozkĆad liczby dni pomiarowych w poszeczegĂłlnych punktach.
zad1 <- przejazdy[,c(1,3)]
zad1 <- zad1 %>%
group_by(Stacja) %>%
summarise(Liczba_dni = n()) %>%
arrange(desc(Liczba_dni))
par(mar=c(5, 11, 4, 2))
barplot(sort(zad1$Liczba_dni),
names.arg = zad1$Stacja[order(zad1$Liczba_dni)],
main = "RozkĆad liczby dni wedĆug punktu pomiarowego",
xlab = "Liczba dni",
space = 0.3,
col = rev(viridis(35)),
horiz=T,
cex.names=0.8,
las=1,
font.axis = 3,
font.lab = 2)
Dla wybranego punktu przedstawiÄ rozkĆad liczby przejazdĂłw.
zad2 <- przejazdy[,c(1,2,3)]
zad2 <- zad2 %>%
filter(Stacja == "Pas Nadmorski")
par(mar=c(5, 5, 4, 2))
hist(zad2$Licznik,
main="RozkĆad liczby przejazdĂłw w punkcie pomiarowym Pas Nadmorski",
xlab="Liczba przejazdĂłw",
ylab = "CzÄstoĆÄ",
col="darkorange1",
border = "black",
breaks = seq(0,12000,500),
xlim = c(0,12500),
las = 1,
font.axis = 3,
font.lab = 2)
PorĂłwnaÄ punkty pod wzglÄdem natÄĆŒenia / rozkĆadu przejazdĂłw.
zad3 <- przejazdy %>%
group_by(Stacja) %>%
summarise(Liczba_dni = n(),
Suma_przejazdow = sum(Licznik),
Natezenie = round(Suma_przejazdow / Liczba_dni,1)) %>%
arrange(desc(Natezenie))
zad3
## # A tibble: 27 x 4
## Stacja Liczba_dni Suma_przejazdow Natezenie
## <fct> <int> <dbl> <dbl>
## 1 Pas Nadmorski 2678 6765929 2526.
## 2 al. ZwyciÄstwa 2739 6249800 2282.
## 3 ul. 3 Maja 2647 4102298 1550.
## 4 al. Grunwaldzka (Wrzeszcz) 2678 3861112 1442.
## 5 ul. Kartuska 1582 1899110. 1200.
## 6 al. Grunwaldzka (UG) 2313 2636624 1140.
## 7 ul. ChĆopska 1613 1824906 1131.
## 8 BĆÄdnik 2037 2250485 1105.
## 9 al. Hallera 1978 2176510 1100.
## 10 al. Rzeczpospolitej 1613 1477426 916.
## # ... with 17 more rows
ggplot(zad3, aes(x = reorder(Stacja, -Natezenie), y = Natezenie)) + geom_bar(stat="identity", fill = heat.colors(27), alpha = 0.8) +
theme(axis.text.x = element_text(angle = 45, hjust = 1),
axis.title.x = element_text(color="Grey40", size=16),
axis.title.y = element_text(color="Grey40", size=16),
legend.position = "none",
plot.title = element_text(color="grey40", face = "bold", size=19, family="serif")) +
scale_y_continuous(breaks = seq(0, 3000, 500)) +
annotate(geom = 'rect',
xmin = 0.5, xmax = 3.5,
ymin = 0.5, ymax = 2600,
fill = 'green',
alpha = 0.4) +
annotate("text", x = 7.5, y = 2400, label = "Stacje o najwiÄkszym natÄĆŒeniu") +
annotate(geom = 'rect',
xmin = 24.5, xmax = 27.5,
ymin = 0.5, ymax = 400,
fill = 'pink',
alpha = 0.6) +
annotate("text", x = 23.5, y = 500, label = "Stacje o najniĆŒszym natÄĆŒeniu") +
xlab("Stacja") +
ylab("NatÄĆŒenie") +
ggtitle('NatÄĆŒenie ruchu rowerowego w zaleĆŒnoĆci od stacji')
zad3.1 <- przejazdy %>%
filter(Stacja == "Pas Nadmorski" | Stacja == "ul. Kartuska" | Stacja == "al. Hallera" |
Stacja == "ul. JaĆkowa Dolina" | Stacja == "ul. Wita Stwosza" | Stacja == "ul. Sucharskiego" |
Stacja == "al. Havla" | Stacja == "al. Ć»oĆnierzy WyklÄtych" | Stacja == "ul. 3 Maja")
ggplot(zad3.1, aes(x = Licznik, fill = Stacja)) + geom_histogram(binwidth = 600, show.legend = F, alpha = 0.8) +
facet_wrap(~Stacja) +
scale_x_continuous(breaks = seq(0, 12000, 1500)) +
xlab("Liczba przejazdĂłw") +
ylab("LiczebnoĆÄ") +
ggtitle('RozkĆady liczby przejazdĂłw dla wybranych stacji') +
theme(axis.text.x = element_text(angle = 45, hjust = 1),
axis.title.x = element_text(color="Grey40", size=16),
axis.title.y = element_text(color="Grey40", size=16),
legend.position = "none",
strip.background = element_rect(colour = "black", fill = "white"),
strip.text = element_text(face = "italic", size = 12),
plot.title = element_text(color="grey40", size=19, family="serif", face = "bold"))
ggplot(zad3.1, aes(x = Licznik, y = Stacja, fill = Stacja)) +
geom_density_ridges(scale = 2, show.legend = F) +
theme_ridges()
ggplot(zad3.1, aes(x = Stacja, y = Licznik, fill = Stacja)) + geom_boxplot(show.legend = F) +
xlab("Stacja") + ylab("Licznik") + ggtitle("RozkĆad liczby przejazdĂłw wzglÄdem wybranej stacji") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1),
axis.title.x = element_text(color="Grey40", size=16),
axis.title.y = element_text(color="Grey40", size=16),
legend.position = "none",
plot.title = element_text(color="grey40", face = "bold", size=19, family="serif"))
PrzedstawiÄ natÄĆŒenie / rozkĆad przejazdĂłw dla wybranej stacji (Pas Nadmorski) w zaleĆŒnoĆci od miesiÄ ca / dnia tygodnia / dni powszednich / weekendowych.
zad4 <- przejazdy %>%
filter(Stacja == "Pas Nadmorski") %>%
group_by(Month) %>%
summarise(Liczba_dni = n(),
Suma_przejazdow = sum(Licznik),
Natezenie = round(Suma_przejazdow / Liczba_dni,1))
ggplot(zad4, aes(x = reorder(Month, -Natezenie), y = Natezenie)) + geom_bar(stat="identity", fill = 'slateblue', alpha = 0.8) +
theme(axis.text.x = element_text(angle = 45, hjust = 1),
axis.title.x = element_text(color="Grey40", size=16),
axis.title.y = element_text(color="Grey40", size=16),
legend.position = "none",
plot.title = element_text(color="grey40", face = "bold", size=19, family="serif")) +
scale_y_continuous(breaks = seq(0, 6000, 500)) +
annotate(geom = 'rect',
xmin = 0.5, xmax = 3.5,
ymin = 0.5, ymax = 5900,
fill = 'green',
alpha = 0.4) +
annotate("text", x = 5.5, y = 5400, label = "MiesiÄ
ce o najwiÄkszym natÄĆŒeniu") +
annotate(geom = 'rect',
xmin = 9.5, xmax = 12.5,
ymin = 0.5, ymax = 800,
fill = 'pink',
alpha = 0.6) +
annotate("text", x = 10.5, y = 1150, label = "MiesiÄ
ce o najniĆŒszym natÄĆŒeniu") +
xlab("MiesiÄ
c") +
ylab("NatÄĆŒenie") +
ggtitle('NatÄĆŒenie ruchu rowerowego w zaleĆŒnoĆci od miesiÄ
ca')
zad4.1 <- przejazdy %>%
filter(Stacja == "Pas Nadmorski") %>%
group_by(Czy_Weekend, Pora_Roku) %>%
summarise(Liczba_dni = n(),
Suma_przejazdow = sum(Licznik),
Natezenie = round(Suma_przejazdow / Liczba_dni,1))
ggplot(zad4.1, aes(x = Czy_Weekend, y = Natezenie, fill = Czy_Weekend)) + geom_col(alpha = 0.8) +
geom_label(aes(x = Czy_Weekend, y = Natezenie, label = Natezenie)) +
scale_fill_manual(values = c('orangered3', 'royalblue2')) +
theme_bw() +
theme(axis.title.x=element_blank(),
axis.title.y = element_text(color="Grey40", size=16),
strip.background = element_rect(colour = "black", fill = 'lightyellow2'),
strip.text = element_text(face = "italic", size = 10),
legend.position = "none",
plot.title = element_text(color="grey40", face = "bold", size=19, family="serif")) +
scale_y_continuous(breaks = seq(0, 8000, 1000)) + facet_wrap(~Pora_Roku)
zad4.2 <- przejazdy %>%
filter(Stacja == "Pas Nadmorski")
ggplot(zad4.2, aes(x = Licznik, fill = Month)) + geom_histogram(binwidth = 800, show.legend = F, alpha = 0.8) +
facet_wrap(~Month) +
scale_x_continuous(breaks = seq(0, 12000, 2000)) +
xlab("Liczba przejazdĂłw") +
ylab("LiczebnoĆÄ") +
theme_bw() +
ggtitle('RozkĆady liczby przejazdĂłw w zaleĆŒnoĆci od miesiÄ
ca') +
theme(axis.text.x = element_text(angle = 45, hjust = 1),
axis.title.x = element_text(color="Grey40", size=16),
axis.title.y = element_text(color="Grey40", size=16),
legend.position = "none",
strip.background = element_rect(colour = "black", fill = "white"),
strip.text = element_text(face = "italic", size = 9),
plot.title = element_text(color="grey40", size=19, family="serif", face = "bold"))
ggplot(zad4.2, aes(x = Licznik, fill = Dzien_tyg)) + geom_histogram(binwidth = 800, show.legend = F, alpha = 0.8) +
facet_wrap(~Dzien_tyg) +
scale_x_continuous(breaks = seq(0, 12000, 2000)) +
xlab("Liczba przejazdĂłw") +
ylab("LiczebnoĆÄ") +
ggtitle('RozkĆady liczby przejazdĂłw w zaleĆŒnoĆci od dnia tygodnia') +
theme_bw() +
theme(axis.text.x = element_text(angle = 45, hjust = 1),
axis.title.x = element_text(color="Grey40", size=16),
axis.title.y = element_text(color="Grey40", size=16),
legend.position = "none",
strip.background = element_rect(colour = "black", fill = "white"),
strip.text = element_text(face = "italic", size = 9),
plot.title = element_text(color="grey40", size=19, family="serif", face = "bold"))
histweek <- ggplot(zad4.2, aes(x = Licznik, fill = Czy_Weekend)) + geom_histogram(binwidth = 800, show.legend = F, alpha = 0.8) +
facet_wrap(~Czy_Weekend) +
scale_x_continuous(breaks = seq(0, 12000, 2000)) +
xlab("Liczba przejazdĂłw") +
ylab("LiczebnoĆÄ") +
ggtitle('Jako histogram') +
theme_bw() +
theme(axis.text.x = element_text(angle = 45, hjust = 1),
axis.title.x = element_text(color="Grey40", size=16),
axis.title.y = element_text(color="Grey40", size=16),
legend.position = "none",
strip.background = element_rect(colour = "black", fill = "white"),
strip.text = element_text(face = "italic", size = 9),
plot.title = element_text(color="grey40", size=19, family="serif", face = "bold"))
boxweek <- ggplot(zad4.2, aes(y = Licznik, fill = Czy_Weekend)) + geom_boxplot(show.legend = F, alpha = 0.8) +
facet_wrap(~Czy_Weekend) +
scale_y_continuous(breaks = seq(0, 12000, 2000)) +
ylab("Liczba przejazdĂłw") +
ggtitle('Jako wykres skrzynkowy') +
theme_bw() +
theme(axis.title.x = element_text(color="Grey40", size=16),
axis.title.y = element_text(color="Grey40", size=16),
axis.text.x=element_blank(),
legend.position = "none",
strip.background = element_rect(colour = "black", fill = "white"),
strip.text = element_text(face = "italic", size = 9),
plot.title = element_text(color="grey40", size=19, family="serif", face = "bold"))
grid.arrange(boxweek, histweek)
ggplot(zad4.2, aes(x = Licznik, fill = Pora_Roku)) + geom_histogram(binwidth = 800, show.legend = F, alpha = 0.8) +
facet_wrap(~Pora_Roku) +
scale_x_continuous(breaks = seq(0, 12000, 2000)) +
xlab("Liczba przejazdĂłw") +
ylab("LiczebnoĆÄ") +
ggtitle('RozkĆady liczby przejazdĂłw w zaleĆŒnoĆci od pory roku') +
scale_fill_manual(values = c('sandybrown', 'firebrick3', 'palegreen3', 'lavender')) +
theme_bw() +
theme(axis.text.x = element_text(angle = 45, hjust = 1),
axis.title.x = element_text(color="Grey40", size=16),
axis.title.y = element_text(color="Grey40", size=16),
legend.position = "none",
strip.background = element_rect(colour = "black", fill = "white"),
strip.text = element_text(face = "italic", size = 9),
plot.title = element_text(color="grey40", size=19, family="serif", face = "bold"))
PorĂłwnaÄ stacje pod wzglÄdem zaleĆŒnoĆci z poprzedniego punktu.
ggplot(data = przejazdy) +
geom_line(stat = "summary",
fun = mean,
mapping =aes(x = Month,
y = Licznik,
group = Dzien_tyg,
color = Dzien_tyg,
linetype = Czy_Weekend)) +
facet_wrap(facets = vars(Stacja),
scales = "free_y") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 70, hjust = 1),
axis.title.x = element_text(color="Grey40", size=16),
axis.title.y = element_text(color="Grey40", size=16),
legend.title = element_text(size=10.5),
legend.text = element_text(size=8.5),
legend.position = "right",
legend.justification = c(0.94,0.94),
legend.background = element_rect(fill="grey88",
size=0.5, linetype="solid",
colour ="darkslateblue"),
strip.background = element_rect(colour = "black", fill = "white"),
strip.text = element_text(face = "italic", size = 9),
plot.title = element_text(color="grey40", size=19, family="serif", face = "bold")) +
ylab("Licznik") + xlab("MiesiÄ
c") +
ggtitle('PorĂłwnanie stacji w zaleĆŒnoĆci od Ćredniej liczby przejazdĂłw')
zad5 <- przejazdy %>%
filter(Stacja == "Pas Nadmorski" | Stacja == 'al. Grunwaldzka (UG)' |
Stacja == "al. Hallera" | Stacja == "ul. JaĆkowa Dolina")
ggplot(zad5, aes(x = Pora_Roku, y = Licznik, fill=Pora_Roku)) + geom_boxplot(size=1.2, alpha=0.5) + facet_grid(~Stacja) +
theme_bw() + ylab("Licznik") +
ggtitle("Wybrane stacje ze wzglÄdu na porÄ roku") +
scale_fill_manual(values = c('sandybrown', 'firebrick3', 'palegreen3', 'lavender')) +
theme(axis.title.y = element_text(color="Grey23", size=16),
axis.text.y = element_text(size=10),
axis.title.x=element_blank(),
legend.title = element_text(size=12),
legend.text = element_text(size=8),
legend.position = "none",
plot.title = element_text(color="grey30", size=22, family="serif"))
ggplot(zad5, aes(x = Czy_Weekend, y = Licznik, fill=Czy_Weekend)) + geom_boxplot(size=1.2, alpha=0.5) + facet_grid(~Stacja) +
theme_bw() + ylab("Licznik") +
ggtitle("Wybrane stacje ze wzglÄdu na dzieĆ tygodnia") +
theme(axis.title.y = element_text(color="Grey23", size=16),
axis.text.y = element_text(size=10),
axis.title.x=element_blank(),
legend.title = element_text(size=12),
legend.text = element_text(size=8),
legend.position = "none",
plot.title = element_text(color="grey30", size=22, family="serif"))
Dla wybranej stacji (Pas Nadmorski) przedstawiÄ zaleĆŒnoĆÄ miÄdzy liczbÄ przejazdĂłw a wybranymi warunkami pogodowymi.
zad6 <- przejazdy %>%
filter(Stacja == "Pas Nadmorski")
ggplot(zad6, aes(x = Temperatura, y = Licznik, color = Pora_Roku, shape = Czy_Weekend)) + geom_point(size = 3, alpha=0.7) +
theme_minimal() +
scale_color_manual(values = c('sandybrown', 'firebrick3', 'palegreen3', 'lavender')) +
ggtitle("ZaleĆŒnoĆÄ liczby przejazdĂłw i temperatury") + xlab("Temperatura [C]") + ylab("Liczba przejazdĂłw") +
theme(axis.title.y = element_text(color="Grey23", size=15),
axis.text.y = element_text(size=12),
axis.title.x = element_text(color="Grey23", size=15),
axis.text.x = element_text(size=12),
legend.title = element_text(size=12),
legend.text = element_text(size=10),
legend.position = "right",
legend.justification = c(0.94,0.94),
legend.background = element_rect(fill="grey88",
size=0.5, linetype="solid",
colour ="grey40"),
plot.title = element_text(color="grey40", size=25, family="serif"))
ggplot(zad6, aes(x = WilgotnoĆÄ, y = Licznik, color = Pora_Roku, shape = Czy_Weekend)) + geom_point(size = 3, alpha=0.7) +
theme_minimal() +
scale_color_manual(values = c('sandybrown', 'firebrick3', 'palegreen3', 'lavender')) +
ggtitle("ZaleĆŒnoĆÄ liczby przejazdĂłw i wilgotnoĆci") + xlab("WilgotnoĆÄ [%]") + ylab("Liczba przejazdĂłw") +
theme(axis.title.y = element_text(color="Grey23", size=15),
axis.text.y = element_text(size=12),
axis.title.x = element_text(color="Grey23", size=15),
axis.text.x = element_text(size=12),
legend.position = "none",
plot.title = element_text(color="grey40", size=25, family="serif"))
ggplot(zad6, aes(x = CiĆnienie_stacja, y = Licznik, color = Pora_Roku, shape = Czy_Weekend)) + geom_point(size = 3, alpha=0.7) +
theme_minimal() +
scale_color_manual(values = c('sandybrown', 'firebrick3', 'palegreen3', 'lavender')) +
ggtitle("ZaleĆŒnoĆÄ liczby przejazdĂłw i ciĆnienia powietrza") + xlab("CiĆnienie powietrza [hPa]") + ylab("Liczba przejazdĂłw") +
theme(axis.title.y = element_text(color="Grey23", size=15),
axis.text.y = element_text(size=12),
axis.title.x = element_text(color="Grey23", size=15),
axis.text.x = element_text(size=12),
legend.position = "none",
plot.title = element_text(color="grey40", size=25, family="serif"))
ggplot(zad6, aes(x = Zachmurzenie, y = Licznik, color = Pora_Roku, shape = Czy_Weekend)) + geom_point(size = 3, alpha=0.7) +
theme_minimal() +
scale_color_manual(values = c('sandybrown', 'firebrick3', 'palegreen3', 'lavender')) +
ggtitle("ZaleĆŒnoĆÄ liczby przejazdĂłw i zachmurzenia") + xlab("Zachmurzenie [oktanty]") + ylab("Liczba przejazdĂłw") +
theme(axis.title.y = element_text(color="Grey23", size=15),
axis.text.y = element_text(size=12),
axis.title.x = element_text(color="Grey23", size=15),
axis.text.x = element_text(size=12),
legend.position = "none",
plot.title = element_text(color="grey40", size=25, family="serif"))
ggplot(zad6, aes(x = Wiatr, y = Licznik, color = Pora_Roku, shape = Czy_Weekend)) + geom_point(size = 3, alpha=0.7) +
theme_minimal() +
scale_color_manual(values = c('sandybrown', 'firebrick3', 'palegreen3', 'lavender')) +
ggtitle("ZaleĆŒnoĆÄ liczby przejazdĂłw i siĆy wiatru") + xlab("Wiatr [m/s]") + ylab("Liczba przejazdĂłw") +
theme(axis.title.y = element_text(color="Grey23", size=15),
axis.text.y = element_text(size=12),
axis.title.x = element_text(color="Grey23", size=15),
axis.text.x = element_text(size=12),
legend.position = "none",
plot.title = element_text(color="grey40", size=25, family="serif"))
PorĂłwnaÄ stacje (wybrane) pod wzglÄdem zaleĆŒnoĆci z poprzedniego punktu.
W tym celu zostaĆa stworzona animacja za pomocÄ pakietu gganimate.
zad7 <- przejazdy %>%
filter(Stacja == "Pas Nadmorski" | Stacja == "ul. Kartuska" | Stacja == "al. Hallera" |
Stacja == "ul. JaĆkowa Dolina" | Stacja == "ul. Wita Stwosza" | Stacja == "ul. Sucharskiego")
chartZad7 <- ggplot(zad7, aes(x = Temperatura, y = Licznik, color = Stacja, size = Wiatr)) +
geom_point(alpha = 0.7, stroke = 1) +
theme_minimal() +
labs(title = "ZaleĆŒnoĆÄ temperatury od liczby przejazdĂłw w czasie",
x = "Temperatura [C]",
y = "Liczba przejazdĂłw") +
theme(axis.title.x = element_text(color="Grey40", size=16),
axis.title.y = element_text(color="Grey40", size=16),
legend.title = element_text(size=10.5),
legend.text = element_text(size=8.5),
legend.position = "right",
legend.justification = c(0.94,0.94),
legend.background = element_rect(fill="grey98",
size=0.5, linetype="solid",
colour ="grey50"),
strip.background = element_rect(colour = "black", fill = "white"),
strip.text = element_text(face = "italic", size = 9),
plot.title = element_text(color="grey40", size=19, family="serif", face = "bold")) +
scale_color_brewer(palette = 'Set2')
mojaAnimacja <- chartZad7 +
transition_time(Data) +
labs(subtitle = "DzieĆ: {frame_time}") +
shadow_wake(wake_length = 0.1)
animate(mojaAnimacja, height = 750, width = 900, nframes= 150, fps = 15, duration = 40, end_pause = 30, res = 100)
anim_save("mojaAnimacja.gif")
NanieĆÄ na mapÄ wybrane statystyki dotyczÄ ce przejazdĂłw w punktach pomiarowych
statystyki <- przejazdy %>%
group_by(Stacja) %>%
summarise("Srednia" = mean(Licznik),
"Odchylenie standardowe" = sd(Licznik),
"Minimum" = min(Licznik),
"Kwartyl 1" = quantile(Licznik, 0.25),
"Mediana" = median(Licznik),
"Kwartyl 3" = quantile(Licznik, 0.75),
"Maksimum" = max(Licznik))
statystyki %>%
kbl(caption = "Podstawowe statystyki dla stacji pomiarowych") %>%
kable_styling(bootstrap_options = c("hover", "condensed")) %>%
kable_paper()
| Stacja | Srednia | Odchylenie standardowe | Minimum | Kwartyl 1 | Mediana | Kwartyl 3 | Maksimum |
|---|---|---|---|---|---|---|---|
| Pas Nadmorski | 2526.4858 | 2348.6505 | 42.0000 | 624.25 | 1556.5 | 4147.75 | 11493 |
| al. ZwyciÄstwa | 2281.7817 | 1684.0541 | 32.0000 | 802.00 | 1821.0 | 3689.50 | 6968 |
| ul. 3 Maja | 1549.7915 | 1040.0276 | 0.0000 | 609.00 | 1339.0 | 2430.00 | 4489 |
| al. Grunwaldzka (Wrzeszcz) | 1441.7894 | 1008.9708 | 30.0000 | 560.00 | 1214.0 | 2207.75 | 4428 |
| BĆÄdnik | 1104.8036 | 846.2111 | 23.0000 | 374.00 | 803.0 | 1819.00 | 3257 |
| al. Hallera | 1100.3589 | 881.1915 | 17.0000 | 353.25 | 756.0 | 1807.25 | 3969 |
| ul. ChĆopska | 1131.3738 | 775.3459 | 23.0000 | 454.00 | 877.0 | 1792.00 | 3097 |
| al. Grunwaldzka (UG) | 1139.9153 | 803.1204 | 23.0000 | 447.00 | 936.0 | 1719.00 | 3777 |
| ul. Kartuska | 1200.4487 | 915.1864 | 22.7269 | 393.25 | 924.0 | 1937.25 | 3806 |
| KanaĆ Raduni | 845.3109 | 680.3250 | 10.0000 | 268.25 | 607.0 | 1369.00 | 2747 |
| al. Rzeczpospolitej | 915.9492 | 673.8896 | 9.0000 | 330.00 | 700.0 | 1485.00 | 2728 |
| ul. KoĆobrzeska | 417.4041 | 316.3826 | 2.0000 | 153.00 | 299.0 | 677.00 | 1271 |
| al. Havla | 556.0905 | 468.3807 | 0.0000 | 152.00 | 386.5 | 933.50 | 2078 |
| ul. Ćostowicka | 518.7133 | 398.4997 | 10.0000 | 169.00 | 400.0 | 837.75 | 1601 |
| ul. JaĆkowa Dolina | 456.5970 | 343.1822 | 19.0000 | 153.00 | 355.0 | 726.00 | 1468 |
| ul. Nowolipie | 426.3689 | 330.8752 | 6.0000 | 140.00 | 318.0 | 700.00 | 1468 |
| ul. Kliniczna | 395.0942 | 300.0793 | 0.0000 | 133.00 | 297.0 | 651.00 | 1632 |
| ul. Wyzwolenia | 359.8239 | 302.2553 | 0.0000 | 108.00 | 221.0 | 621.00 | 1733 |
| ul. RybiĆskiego | 372.7545 | 289.8148 | 0.0000 | 134.00 | 269.0 | 603.00 | 1425 |
| al. ƻoĆnierzy WyklÄtych | 351.3504 | 255.8096 | 7.0000 | 126.00 | 272.0 | 568.00 | 1058 |
| ul. Stryjewskiego | 314.1943 | 258.3993 | 0.0000 | 93.00 | 215.0 | 525.00 | 1148 |
| ul. Wita Stwosza | 289.7849 | 209.5101 | 0.0000 | 107.75 | 245.0 | 447.00 | 1001 |
| al. Jana PawĆa II | 296.4346 | 235.1679 | 0.0000 | 96.00 | 219.0 | 470.00 | 1050 |
| ul. Sucharskiego | 176.6255 | 157.5612 | 0.0000 | 51.00 | 109.0 | 288.00 | 838 |
| ul. ElblÄ ska | 175.3428 | 137.3663 | 0.0000 | 58.00 | 122.0 | 295.00 | 619 |
| Karczemki | 345.9585 | 270.3222 | 10.0000 | 111.00 | 257.0 | 555.00 | 1213 |
| ul. SĆowackiego (Matarnia) | 220.8628 | 171.5084 | 6.0000 | 74.00 | 162.0 | 356.00 | 724 |
punkty <- left_join(x = punkty,
y = statystyki,
by = "Stacja")
tmap_mode("view")
tm_shape(punkty) +
tm_symbols(size = "Srednia",
scale = 6,
col = "royalblue3",
alpha = 0.7) +
tm_basemap(providers$OpenStreetMap)
tmap_mode("view")
tm_shape(punkty) +
tm_symbols(size = "Mediana",
scale = 6,
col = "salmon3",
alpha = 0.7) +
tm_basemap(providers$OpenStreetMap)
tmap_mode("view")
tm_shape(punkty) +
tm_symbols(size = "Maksimum",
scale = 6,
col = "darkorchid2",
alpha = 0.7) +
tm_basemap(providers$OpenStreetMap)
PrzedstawiÄ zaleĆŒnoĆci miÄdzy zmiennymi opisujÄ cymi warunki pogodowe.
zad9 <- przejazdy[, c(4:12)]
pogodaKor <- round(cor(zad9),2)
ggcorrplot(pogodaKor, hc.order = TRUE, type = "lower",
outline.col = "white", colors = c('coral2', 'azure1', 'palegreen2'), lab = T)
ggplot(zad9, aes(x = Zachmurzenie, y = WilgotnoĆÄ)) + geom_hex(bins = 60) +
scale_fill_gradient(low = "lightsteelblue1", high = "springgreen3") +
theme_minimal() +
ylab("Zachmurzenie [oktany]") + ylab("WilgotnoĆÄ [%]") +
ggtitle('ZaleĆŒnoĆÄ pomiÄdzy wilgotnoĆciÄ
i zachmurzeniem') +
theme(axis.title.x = element_text(color="Grey40", size=16),
axis.title.y = element_text(color="Grey40", size=16),
plot.title = element_text(color="grey40", size=19, family="serif", face = "bold"))
ggplot(zad9, aes(x = CiĆnienie_stacja, y = CiĆnienie_morze)) + geom_hex(bins = 80) +
scale_fill_gradient(low = "khaki3", high = "darkorchid2") +
theme_minimal() +
ylab("CiĆnienie morza [hPa]") + xlab("CiĆnienie powietrza [hPa]") +
ggtitle('ZaleĆŒnoĆÄ pomiÄdzy ciĆnienem morza i powietrza') +
theme(axis.title.x = element_text(color="Grey40", size=16),
axis.title.y = element_text(color="Grey40", size=16),
plot.title = element_text(color="grey40", size=19, family="serif", face = "bold"))
ggplot(zad9, aes(x = Temperatura, y = WilgotnoĆÄ)) + geom_hex(bins = 70) +
scale_fill_gradient(low = "deepskyblue2", high = "firebrick3") +
theme_minimal() +
ylab("WilgotnoĆÄ [%]") + xlab("Temperatura [C]") +
ggtitle('ZaleĆŒnoĆÄ pomiÄdzy wilgotnoĆciÄ
i temperaturÄ
') +
theme(axis.title.x = element_text(color="Grey40", size=16),
axis.title.y = element_text(color="Grey40", size=16),
plot.title = element_text(color="grey40", size=19, family="serif", face = "bold"))
ggplot(zad9, aes(x = Temperatura, y = CiĆnienie_woda)) + geom_hex(bins = 70) +
scale_fill_gradient(low = "cadetblue2", high = "goldenrod3") +
theme_minimal() +
ylab("CiĆnienie wody [hPa]") + xlab("Temperatura [C]") +
ggtitle('ZaleĆŒnoĆÄ pomiÄdzy ciĆnienem wody i temperaturÄ
') +
theme(axis.title.x = element_text(color="Grey40", size=16),
axis.title.y = element_text(color="Grey40", size=16),
plot.title = element_text(color="grey40", size=19, family="serif", face = "bold"))
ggplot(zad9, aes(x = WilgotnoĆÄ, y = Opady_dzieĆ)) + geom_hex(bins = 70) +
scale_fill_gradient(low = "lightblue3", high = "deeppink3") +
theme_minimal() +
ylab("Suma opadĂłw w ciÄ
gu dnia [mm]") + xlab("WilgotnoĆÄ [%]") +
ggtitle('ZaleĆŒnoĆÄ pomiÄdzy sumÄ
opadĂłw w ciÄ
gu dnia i wilgotnoĆciÄ
') +
theme(axis.title.x = element_text(color="Grey40", size=16),
axis.title.y = element_text(color="Grey40", size=16),
plot.title = element_text(color="grey40", size=19, family="serif", face = "bold"))
ggplot(przejazdy, aes(x = Month, y = Temperatura, fill = Month)) + geom_boxplot(alpha = 0.8) + theme_bw() +
theme(axis.text.x = element_text(angle = 45, hjust = 1),
axis.title.x = element_text(color="Grey40", size=16),
axis.title.y = element_text(color="Grey40", size=16),
legend.position = "none",
strip.background = element_rect(colour = "black", fill = "white"),
strip.text = element_text(face = "italic", size = 9),
plot.title = element_text(color="grey40", size=19, family="serif", face = "bold")) +
ylab("Temperatura") + xlab("MiesiÄ
c") +
ggtitle('RozkĆad wartoĆci temperatur wzglÄdem miesiÄ
ca')
ggplot(przejazdy, aes(x = Month, y = Zachmurzenie, fill = Month)) + geom_boxplot(alpha = 0.8) + theme_bw() +
theme(axis.text.x = element_text(angle = 45, hjust = 1),
axis.title.x = element_text(color="Grey40", size=16),
axis.title.y = element_text(color="Grey40", size=16),
legend.position = "none",
strip.background = element_rect(colour = "black", fill = "white"),
strip.text = element_text(face = "italic", size = 9),
plot.title = element_text(color="grey40", size=19, family="serif", face = "bold")) +
ylab("Zachmurzenie") + xlab("MiesiÄ
c") +
ggtitle('RozkĆad wartoĆci zachmurzenia wzglÄdem miesiÄ
ca')
ggplot(przejazdy, aes(x = Month, y = Wiatr, fill = Month)) + geom_boxplot(alpha = 0.8) + theme_bw() +
theme(axis.text.x = element_text(angle = 45, hjust = 1),
axis.title.x = element_text(color="Grey40", size=16),
axis.title.y = element_text(color="Grey40", size=16),
legend.position = "none",
strip.background = element_rect(colour = "black", fill = "white"),
strip.text = element_text(face = "italic", size = 9),
plot.title = element_text(color="grey40", size=19, family="serif", face = "bold")) +
ylab("Wiatr") + xlab("MiesiÄ
c") +
ggtitle('RozkĆad wartoĆci siĆy wiatru wzglÄdem miesiÄ
ca')
ggplot(przejazdy, aes(x = Temperatura, y = Month, fill = stat(x))) +
geom_density_ridges_gradient(scale = 3, rel_min_height = 0.01) +
scale_fill_viridis_c(name = "Temp. [C]", option = "B") +
theme_ridges() + labs(title = 'Temperatury w zaleĆŒnoĆci od miesiÄ
ca') +
xlab('Temparatura') + ylab("MiesiÄ
c")
ggplot(przejazdy, aes(x = CiĆnienie_stacja, y = Month, fill = stat(x))) +
geom_density_ridges_gradient(scale = 3, rel_min_height = 0.01) +
scale_fill_viridis_c(name = "CiĆ. [hPa]", option = "E") +
theme_ridges() + labs(title = 'CiĆnienie powietrza w zaleĆŒnoĆci od miesiÄ
ca') + xlab("CiĆnienie powietrza") +
ylab("MiesiÄ
c")
ggplot(przejazdy, aes(x = WilgotnoĆÄ, y = Month, fill = stat(x))) +
geom_density_ridges_gradient(scale = 3, rel_min_height = 0.01) +
scale_fill_viridis_c(name = "Wilg. [%]", option = "D") +
theme_ridges() + labs(title = 'WilgotnoĆÄ powietrza w zaleĆŒnoĆci od miesiÄ
ca') + xlab("WilgotnoĆÄ powietrza") +
ylab("MiesiÄ
c")
doKalendarza <- przejazdy[przejazdy$Year == "2019" & przejazdy$CiĆnienie_stacja > 1022.0, ]
unique(doKalendarza$Data)
## [1] "2019-01-03" "2019-01-06" "2019-01-07" "2019-02-04" "2019-02-05"
## [6] "2019-02-06" "2019-02-14" "2019-02-15" "2019-02-16" "2019-02-22"
## [11] "2019-02-23" "2019-02-24" "2019-02-25" "2019-02-26" "2019-03-20"
## [16] "2019-03-21" "2019-03-22" "2019-03-23" "2019-03-27" "2019-03-28"
## [21] "2019-03-29" "2019-04-01" "2019-04-11" "2019-04-12" "2019-04-13"
## [26] "2019-04-14" "2019-04-15" "2019-04-16" "2019-04-17" "2019-04-18"
## [31] "2019-04-19" "2019-04-20" "2019-04-21" "2019-04-22" "2019-05-12"
## [36] "2019-05-13" "2019-05-14" "2019-05-15" "2019-05-30" "2019-06-09"
## [41] "2019-06-23" "2019-06-24" "2019-06-25" "2019-08-21" "2019-08-22"
## [46] "2019-08-23" "2019-08-24" "2019-08-25" "2019-08-26" "2019-09-12"
## [51] "2019-09-13" "2019-09-14" "2019-09-20" "2019-10-30" "2019-10-31"
## [56] "2019-12-27" "2019-12-28" "2019-12-29"
yday(unique(doKalendarza$Data))
## [1] 3 6 7 35 36 37 45 46 47 53 54 55 56 57 79 80 81 82 86
## [20] 87 88 91 101 102 103 104 105 106 107 108 109 110 111 112 132 133 134 135
## [39] 150 160 174 175 176 233 234 235 236 237 238 255 256 257 263 303 304 361 362
## [58] 363
calendR(year = 2019,
start = "M",
special.days = c(3, 6, 7, 35, 36, 37, 45, 46, 47, 53, 54,
55, 56, 57, 79, 80, 81, 82,
86, 87, 88, 91, 101, 102, 103, 104, 105, 106, 107,
108, 109, 110, 111, 112, 132, 133, 134, 135, 150, 160,
174, 175, 176, 233, 234, 235, 236, 237, 238, 255, 256, 257,
263, 303, 304, 361, 362, 363),
special.col = "deepskyblue3",
low.col = "white",
weeknames.col = "white",
weeknames.size = 4,
lty = 2,
title = "Dni w 2019 roku z ciĆnieniem powietrza powyĆŒej 1022.0 hPa",
title.size = 20,
title.col = 'darkslateblue',
mbg.col = 'lightgoldenrod3',
bg.img = 'pressure.jpg',
font.family = "sans",
font.style = "plain")